home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / tools / istan / ANLIB1.MAC.f < prev    next >
Encoding:
Text File  |  1989-03-04  |  63.6 KB  |  1,553 lines
  1. C---------------------------------------------------------
  2. C    TOOLPACK/1    Release: 2.3
  3. C---------------------------------------------------------
  4. C---------------------------------------------------------
  5. C    TOOLPACK/1    Release: 2.3
  6. C---------------------------------------------------------
  7. C ----------------------------------------------------------------------
  8. C
  9. C       A N B L K   -   Global data constants for ISTAN
  10. C
  11.  
  12.         BLOCK DATA ANBLK
  13.  
  14. C---------------------------------------------------------
  15. C    TOOLPACK/1    Release: 2.3
  16. C---------------------------------------------------------
  17. C                  LOGICAL VARIABLES
  18.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  19.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  20.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  21.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  22.      *         TREEG
  23.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  24.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  25.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  26.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  27.  
  28.         SAVE /LOGIC/
  29.  
  30. C---------------------------------------------------------
  31. C    TOOLPACK/1    Release: 2.3
  32. C---------------------------------------------------------
  33. C Option Settings
  34.         COMMON /OPTSC/ INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,
  35.      +                 MTREQG,TIEG,ITRUNG
  36.  
  37.         INTEGER INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,MTREQG,
  38.      +          ITRUNG
  39.         LOGICAL TIEG
  40.  
  41.         SAVE /OPTSC/
  42.  
  43. C---------------------------------------------------------
  44. C    TOOLPACK/1    Release: 2.3
  45. C---------------------------------------------------------
  46.         COMMON/ANVNAM/VNAMEG
  47.         CHARACTER*5 VNAMEG
  48.         SAVE/ANVNAM/
  49.  
  50. C **********************************************************************
  51. C *                                                                    *
  52. C *     HOST-SENSITIVE VALUES:                                         *
  53. C *     ----------------------                                         *
  54. C *     The following values are for i/o unit numbers, used in non     *
  55. C *     TIE-conforming programs.  They should be set to something      *
  56. C *     appropriate for the host system.                               *
  57. C *         INHSTG  -  History file input unit                         *
  58. C *         ITHSTG  -  History file output unit                        *
  59. C *         INTRAG  -  Trace information input unit (standard input)   *
  60. C *         ITTRAG  -  Trace information output unit (standard o/p)    *
  61. C *         ITLSTG  -  Listing output unit (standard output)           *
  62. C *                                                                    *
  63. C **********************************************************************
  64.  
  65. C Option defaults
  66.         DATA ASSRTG,HISTG,TIEG,TRACEG/4*.FALSE./
  67. C Instrumented program I/O units
  68.         DATA INHSTG,ITHSTG,INTRAG,ITTRAG,ITLSTG,ITRUNG,VNAMEG/
  69.      +          8  ,   8  ,   5  ,   6  ,   6  ,  -1  ,'ZZ4QX'/
  70. C Instrumented program: TRACE circular buffer size
  71.         DATA MCIRCG/100/
  72. C Instrumented program: Maximum number of TRACE requests
  73.         DATA MTREQG/25/
  74.  
  75.         END
  76. C ----------------------------------------------------------------------
  77. C
  78. C       A S S R T S   -   Process and output an assertion statement
  79. C
  80.  
  81.         SUBROUTINE ASSRTS
  82.  
  83. C---------------------------------------------------------
  84. C    TOOLPACK/1    Release: 2.3
  85. C---------------------------------------------------------
  86. C Character variables and arrays, except for dictionaries & VNAMEG
  87.         INTEGER MAXCMG
  88.         PARAMETER(MAXCMG=30)
  89.         COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
  90.  
  91.         CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
  92.         CHARACTER*6 NAMEG
  93.         CHARACTER*72 ICOMG(MAXCMG)
  94.  
  95.         SAVE /CHARC/
  96. C---------------------------------------------------------
  97. C    TOOLPACK/1    Release: 2.3
  98. C---------------------------------------------------------
  99. C                  CONTROL VARIABLES
  100.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  101.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  102.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  103.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  104.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  105.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  106.      *         NSTMG,       NTREEG,      NTYPEG
  107.  
  108.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  109.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  110.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  111.      +          NTREEG,NTYPEG
  112.  
  113.         SAVE /CNTRLC/
  114.  
  115. C---------------------------------------------------------
  116. C    TOOLPACK/1    Release: 2.3
  117. C---------------------------------------------------------
  118. C                  LOGICAL VARIABLES
  119.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  120.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  121.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  122.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  123.      *         TREEG
  124.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  125.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  126.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  127.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  128.  
  129.         SAVE /LOGIC/
  130.  
  131. C---------------------------------------------------------
  132. C    TOOLPACK/1    Release: 2.3
  133. C---------------------------------------------------------
  134.         COMMON/ANVNAM/VNAMEG
  135.         CHARACTER*5 VNAMEG
  136.         SAVE/ANVNAM/
  137. C---------------------------------------------------------
  138. C    TOOLPACK/1    Release: 2.4
  139. C---------------------------------------------------------
  140. C
  141. C  TKLAST = LAST TOKEN NUMBER
  142. C
  143.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  144.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  145.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  146.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  147.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  148.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  149.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  150.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  151.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  152.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  153.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  154.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  155.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  156.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  157.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  158.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  159.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  160.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  161.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  162.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  163.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  164.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  165.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  166.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  167.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  168.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  169.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  170.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  171.  
  172.  
  173.         INTEGER JCOL,ICOL,L
  174.         CHARACTER*5 ASSNUM
  175.         CHARACTER*72 CMTEXT
  176.  
  177. *$AS$ (ASSRTG)
  178. *$AS$ (NSTMG.GT.0)
  179. *$AS$ (ISTMG(1).EQ.'*')
  180.         NMASRG=NMASRG+1
  181. C Output first annotated listing line
  182.         WRITE(ASSNUM,9000) NMASRG
  183.         CALL WRITOK(TCMMNT,'*$AN$'//ASSNUM//'A')
  184.         DO 50 L=1,MIN(72,NSTMG)
  185.             CMTEXT(L:L)=ISTMG(L)
  186.   50    CONTINUE
  187.         CALL WRITOK(TCMMNT,CMTEXT(:MIN(72,NSTMG)))
  188. C Output additional annotated listing lines, if required
  189.         IF (NSTMG.GT.72) THEN
  190.             DO 200 ICOL=73,NSTMG,71
  191.                 JCOL=MIN(ICOL+70,NSTMG)
  192.                 DO 100 L=ICOL,JCOL
  193.  100                CMTEXT(L-ICOL+1:L-ICOL+1)=ISTMG(L)
  194.                 CALL WRITOK(TCMMNT,'*'//CMTEXT(:JCOL-ICOL+1))
  195.  200        CONTINUE
  196.         END IF
  197. *$as$ (NBUFFG.EQ.0)
  198.         NBUFFG=0
  199.         CALL SENDCH('      CALL M'//VNAMEG//'(')
  200.         CALL SENDAS
  201.         CALL SENDCH(','//ASSNUM//')')
  202.         CALL SEND
  203.  
  204. 9000    FORMAT(SS,I5)
  205.         END
  206. C ----------------------------------------------------------------------
  207. C
  208. C       B A D A S   -   Current assertion statement bad.
  209. C                       Ignore as assertion and output with comments.
  210. C
  211.  
  212.         SUBROUTINE BADAS
  213.  
  214. C---------------------------------------------------------
  215. C    TOOLPACK/1    Release: 2.3
  216. C---------------------------------------------------------
  217. C Character variables and arrays, except for dictionaries & VNAMEG
  218.         INTEGER MAXCMG
  219.         PARAMETER(MAXCMG=30)
  220.         COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
  221.  
  222.         CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
  223.         CHARACTER*6 NAMEG
  224.         CHARACTER*72 ICOMG(MAXCMG)
  225.  
  226.         SAVE /CHARC/
  227. C---------------------------------------------------------
  228. C    TOOLPACK/1    Release: 2.3
  229. C---------------------------------------------------------
  230. C                  LOGICAL VARIABLES
  231.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  232.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  233.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  234.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  235.      *         TREEG
  236.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  237.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  238.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  239.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  240.  
  241.         SAVE /LOGIC/
  242.  
  243. C---------------------------------------------------------
  244. C    TOOLPACK/1    Release: 2.3
  245. C---------------------------------------------------------
  246. C                  CONTROL VARIABLES
  247.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  248.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  249.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  250.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  251.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  252.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  253.      *         NSTMG,       NTREEG,      NTYPEG
  254.  
  255.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  256.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  257.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  258.      +          NTREEG,NTYPEG
  259.  
  260.         SAVE /CNTRLC/
  261.  
  262. C---------------------------------------------------------
  263. C    TOOLPACK/1    Release: 2.3
  264. C---------------------------------------------------------
  265. C                  KEYWORD ID VARIABLES
  266.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  267.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  268.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  269.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  270.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  271.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  272.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  273.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  274.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  275.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  276.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  277.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  278.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  279.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  280.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  281.      *         LLINEG,      LSTMTG
  282.  
  283.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  284.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  285.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  286.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  287.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  288.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  289.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  290.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  291.         INTEGER KUFUNG,KSUBRG
  292.  
  293.         SAVE /KEYSC/
  294.  
  295. C---------------------------------------------------------
  296. C    TOOLPACK/1    Release: 2.4
  297. C---------------------------------------------------------
  298. C
  299. C  TKLAST = LAST TOKEN NUMBER
  300. C
  301.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  302.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  303.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  304.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  305.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  306.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  307.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  308.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  309.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  310.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  311.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  312.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  313.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  314.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  315.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  316.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  317.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  318.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  319.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  320.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  321.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  322.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  323.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  324.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  325.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  326.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  327.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  328.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  329.  
  330.  
  331.         INTEGER NSTML,MSTML,L
  332.         CHARACTER*71 CMTEXT
  333.  
  334.         NSTML=1
  335. *$AS$ (NSTMG.GT.0 .AND. ASSRTG)
  336. C Locate next assertion card end
  337.   100   NSTML=NSTML+71
  338.         CALL COUNTS(LCMNTG)
  339.         MSTML=NSTML-70
  340.         DO 200 L=MSTML,NSTML
  341.  200        CMTEXT(L-MSTML+1:L-MSTML+1)=ISTMG(L)
  342.         CALL WRITOK(TCMMNT,'C'//CMTEXT)
  343. C Are there more assertion cards?
  344.         IF (NSTML.LT.NSTMG) GOTO 100
  345.         NSTMG=0
  346.  
  347.         END
  348. C ----------------------------------------------------------------------
  349. C
  350. C       B A L C C S   -   Find the end of a character constant field.
  351. C                         return the column of the last character if
  352. C                         found, or the starting column if not found.
  353. C
  354.  
  355.         SUBROUTINE BALCCS(ICOLA,JCOLA)
  356.         INTEGER ICOLA,JCOLA
  357.  
  358. C---------------------------------------------------------
  359. C    TOOLPACK/1    Release: 2.3
  360. C---------------------------------------------------------
  361. C Character variables and arrays, except for dictionaries & VNAMEG
  362.         INTEGER MAXCMG
  363.         PARAMETER(MAXCMG=30)
  364.         COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
  365.  
  366.         CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
  367.         CHARACTER*6 NAMEG
  368.         CHARACTER*72 ICOMG(MAXCMG)
  369.  
  370.         SAVE /CHARC/
  371. C---------------------------------------------------------
  372. C    TOOLPACK/1    Release: 2.3
  373. C---------------------------------------------------------
  374. C                  CONTROL VARIABLES
  375.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  376.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  377.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  378.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  379.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  380.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  381.      *         NSTMG,       NTREEG,      NTYPEG
  382.  
  383.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  384.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  385.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  386.      +          NTREEG,NTYPEG
  387.  
  388.         SAVE /CNTRLC/
  389.  
  390.  
  391.         INTEGER ICOL,L
  392.  
  393. C Start search in column after first quote
  394.         ICOL=ICOLA+1
  395.         IF (NSTMG.GE.ICOL) THEN
  396.   100       DO 200 L=ICOL,NSTMG
  397. C Check for two consecutive quotes
  398.                 IF (ISTMG(L).EQ.'''') THEN
  399.                     IF (ISTMG(L+1).NE.'''' .OR. L+1.GT.NSTMG) THEN
  400. C End of field found
  401.                         JCOLA=L
  402.                         RETURN
  403.                     ELSE
  404. C Skip over two consecutive quotes
  405.                         ICOL=L+2
  406.                         GOTO 100
  407.                     END IF
  408.                 END IF
  409.   200       CONTINUE
  410.         END IF
  411. C End of field never located
  412.         JCOLA = ICOLA
  413.  
  414.         END
  415. C ----------------------------------------------------------------------
  416. C
  417. C       B A L P R S   -   Balance parentheses. Return column of end of
  418. C                         field if found, or a zero if not balanced.
  419. C                         [This works on assertion statements only].
  420. C
  421.  
  422.         SUBROUTINE BALPRS(ICOLA,JCOLA)
  423.         INTEGER ICOLA,JCOLA
  424.  
  425. C---------------------------------------------------------
  426. C    TOOLPACK/1    Release: 2.3
  427. C---------------------------------------------------------
  428. C Character variables and arrays, except for dictionaries & VNAMEG
  429.         INTEGER MAXCMG
  430.         PARAMETER(MAXCMG=30)
  431.         COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
  432.  
  433.         CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
  434.         CHARACTER*6 NAMEG
  435.         CHARACTER*72 ICOMG(MAXCMG)
  436.  
  437.         SAVE /CHARC/
  438. C---------------------------------------------------------
  439. C    TOOLPACK/1    Release: 2.3
  440. C---------------------------------------------------------
  441. C                  CONTROL VARIABLES
  442.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  443.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  444.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  445.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  446.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  447.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  448.      *         NSTMG,       NTREEG,      NTYPEG
  449.  
  450.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  451.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  452.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  453.      +          NTREEG,NTYPEG
  454.  
  455.         SAVE /CNTRLC/
  456.  
  457.  
  458.         INTEGER ICOL,IBAL,L,NEWL
  459.  
  460.         IBAL=-1
  461.         JCOLA=0
  462.         ICOL=ICOLA
  463.         IF (NSTMG.GE.ICOL) THEN
  464.   100       DO 200 L=ICOL,NSTMG
  465. C Is this the start of the field?
  466.                 IF (IBAL.LT.0 .AND. ISTMG(L).EQ.'(') THEN
  467.                     IBAL=1
  468. C Is this the start of a subfield?
  469.                 ELSE IF (ISTMG(L).EQ.'(') THEN
  470.                     IBAL=IBAL+1
  471. C Is this the end of a field?
  472.                 ELSE IF (ISTMG(L).EQ.')') THEN
  473.                     IBAL=IBAL-1
  474. C Is this the start of a character constant field?
  475.                 ELSE IF (ISTMG(L).EQ.'''') THEN
  476. C Find the end of the character constant field.
  477.                     CALL BALCCS(L,NEWL)
  478.                     IF (NEWL.EQ.L) THEN
  479. C No end to character constant found
  480.                         RETURN
  481.                     ELSE
  482. C End to character constant found
  483.                         ICOL=NEWL+1
  484.                         GOTO 100
  485.                     END IF
  486.                 END IF
  487. C Do the parentheses balance?
  488.                 IF (IBAL.EQ.0) THEN
  489.                     JCOLA=L
  490.                     RETURN
  491.                 END IF
  492.   200       CONTINUE
  493.         END IF
  494.  
  495.         END
  496. C ----------------------------------------------------------------------
  497. C
  498. C       B A L P R T   -   Balance parentheses (token version).
  499. C                         Return token of closing parenthesis if found,
  500. C                         or zero if unbalanced.
  501. C
  502.  
  503.         SUBROUTINE BALPRT(ITOKA,JTOKA)
  504.         INTEGER ITOKA,JTOKA
  505.  
  506. C---------------------------------------------------------
  507. C    TOOLPACK/1    Release: 2.4
  508. C---------------------------------------------------------
  509. C
  510. C  TKLAST = LAST TOKEN NUMBER
  511. C
  512.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  513.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  514.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  515.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  516.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  517.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  518.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  519.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  520.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  521.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  522.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  523.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  524.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  525.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  526.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  527.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  528.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  529.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  530.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  531.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  532.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  533.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  534.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  535.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  536.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  537.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  538.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  539.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  540.  
  541. C---------------------------------------------------------
  542. C    TOOLPACK/1    Release: 2.3
  543. C---------------------------------------------------------
  544.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  545.      +                MAXICH
  546.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  547.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  548.      +          MAXICH
  549.  
  550.         SAVE /TOKENS/
  551.  
  552. C
  553. C TOKTYP = array of token types for current statement
  554. C TOKLEN = parallel array of lengths of associated text strings
  555. C TXTPTR = parallel array of pointers into ISTMG character array of text
  556. C TOKEN = Current token number within statement being processed
  557. C NTOKSS = Number of tokens in statement
  558. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  559. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  560. C MAXICH = Last character used in ISTTXT array
  561. C
  562.  
  563.         INTEGER IBAL,ITOK,L
  564.  
  565.         IBAL=-1
  566.         JTOKA=0
  567.         ITOK=ITOKA
  568.         IF (NTOKSS.GE.ITOK) THEN
  569.             DO 100 L=ITOK,NTOKSS
  570.                 IF (TOKTYP(L).EQ.TLPARN) THEN
  571.                     IF (IBAL.LT.0) IBAL=0
  572.                     IBAL=IBAL+1
  573.                 ELSE IF (TOKTYP(L).EQ.TRPARN) THEN
  574.                     IBAL=IBAL-1
  575.                 END IF
  576.                 IF (IBAL.EQ.0) THEN
  577.                     JTOKA=L
  578.                     RETURN
  579.                 END IF
  580.  100        CONTINUE
  581.         END IF
  582.  
  583.         END
  584. C ----------------------------------------------------------------------
  585. C
  586. C       S E N D A S   -   Send assertion to intermediate file, with
  587. C                         blanks suppressed (except in char constants).
  588. C
  589.  
  590.         SUBROUTINE SENDAS
  591.  
  592. C---------------------------------------------------------
  593. C    TOOLPACK/1    Release: 2.3
  594. C---------------------------------------------------------
  595. C Character variables and arrays, except for dictionaries & VNAMEG
  596.         INTEGER MAXCMG
  597.         PARAMETER(MAXCMG=30)
  598.         COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
  599.  
  600.         CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
  601.         CHARACTER*6 NAMEG
  602.         CHARACTER*72 ICOMG(MAXCMG)
  603.  
  604.         SAVE /CHARC/
  605. C---------------------------------------------------------
  606. C    TOOLPACK/1    Release: 2.3
  607. C---------------------------------------------------------
  608. C                  CONTROL VARIABLES
  609.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  610.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  611.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  612.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  613.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  614.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  615.      *         NSTMG,       NTREEG,      NTYPEG
  616.  
  617.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  618.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  619.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  620.      +          NTREEG,NTYPEG
  621.  
  622.         SAVE /CNTRLC/
  623.  
  624.  
  625.         INTEGER I
  626.         LOGICAL CCONST
  627.  
  628.         CCONST=.FALSE.
  629.         DO 100 I=2,NSTMG
  630.             IF (ISTMG(I).EQ.'''') CCONST=.NOT.CCONST
  631.             IF (ISTMG(I).NE.' '.OR.CCONST) THEN
  632.                 NBUFFG=NBUFFG+1
  633.                 IBUFFG(NBUFFG)=ISTMG(I)
  634.             END IF
  635. 100     CONTINUE
  636.  
  637.         END
  638. C ----------------------------------------------------------------------
  639. C
  640. C       C O M N T S   -   Process comments.
  641. C                         Check for assertions and save non-assertion
  642. C                         comments between statements.
  643. C
  644.  
  645.         SUBROUTINE COMNTS(ISAVEA)
  646.         INTEGER ISAVEA
  647.  
  648. C---------------------------------------------------------
  649. C    TOOLPACK/1    Release: 2.3
  650. C---------------------------------------------------------
  651. C Character variables and arrays, except for dictionaries & VNAMEG
  652.         INTEGER MAXCMG
  653.         PARAMETER(MAXCMG=30)
  654.         COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
  655.  
  656.         CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
  657.         CHARACTER*6 NAMEG
  658.         CHARACTER*72 ICOMG(MAXCMG)
  659.  
  660.         SAVE /CHARC/
  661. C---------------------------------------------------------
  662. C    TOOLPACK/1    Release: 2.3
  663. C---------------------------------------------------------
  664. C                  LOGICAL VARIABLES
  665.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  666.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  667.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  668.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  669.      *         TREEG
  670.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  671.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  672.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  673.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  674.  
  675.         SAVE /LOGIC/
  676.  
  677. C---------------------------------------------------------
  678. C    TOOLPACK/1    Release: 2.3
  679. C---------------------------------------------------------
  680. C                  CONTROL VARIABLES
  681.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  682.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  683.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  684.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  685.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  686.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  687.      *         NSTMG,       NTREEG,      NTYPEG
  688.  
  689.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  690.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  691.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  692.      +          NTREEG,NTYPEG
  693.  
  694.         SAVE /CNTRLC/
  695.  
  696. C---------------------------------------------------------
  697. C    TOOLPACK/1    Release: 2.3
  698. C---------------------------------------------------------
  699. C                  KEYWORD ID VARIABLES
  700.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  701.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  702.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  703.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  704.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  705.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  706.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  707.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  708.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  709.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  710.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  711.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  712.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  713.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  714.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  715.      *         LLINEG,      LSTMTG
  716.  
  717.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  718.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  719.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  720.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  721.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  722.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  723.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  724.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  725.         INTEGER KUFUNG,KSUBRG
  726.  
  727.         SAVE /KEYSC/
  728.  
  729. C---------------------------------------------------------
  730. C    TOOLPACK/1    Release: 2.3
  731. C---------------------------------------------------------
  732.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  733.      +                MAXICH
  734.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  735.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  736.      +          MAXICH
  737.  
  738.         SAVE /TOKENS/
  739.  
  740. C
  741. C TOKTYP = array of token types for current statement
  742. C TOKLEN = parallel array of lengths of associated text strings
  743. C TXTPTR = parallel array of pointers into ISTMG character array of text
  744. C TOKEN = Current token number within statement being processed
  745. C NTOKSS = Number of tokens in statement
  746. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  747. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  748. C MAXICH = Last character used in ISTTXT array
  749. C
  750.  
  751.         INTEGER ICOL,ID(3),BODY(134),ASTEXT(3),BIND
  752.         CHARACTER CARD*72
  753.         EQUIVALENCE (CARD,ICARDG)
  754.  
  755.         INTRINSIC INDEX
  756.  
  757.         INTEGER ZSEDID,EQUAL
  758.         EXTERNAL ZSEDID,EQUAL
  759.  
  760.         DATA ASTEXT/97,115,129/
  761.  
  762.         ISAVEA=1
  763.         IF (ZSEDID(ISTTXT(ISTPTR(NTOKSS)),BIND,ID,BODY).NE.-2) GOTO 100
  764.         IF (EQUAL(ID,ASTEXT).NE.-2) GOTO 100
  765. C Is current statement being collected an assertion?
  766.         IF (NSTMG.GT.0 .AND. ISTMG(1).EQ.'*') THEN
  767. C Current statement being collected is assertion; return this comment as
  768. C possible continuation.
  769.             ISAVEA=0
  770.         ELSE IF (ASSRTG) THEN
  771. C This card may start an assertion
  772.             ICOL=INDEX(CARD,'(')
  773.             IF (ICOL.GT.0) THEN
  774. C Left parenthesis found, comment starts assertion.
  775.                 ISAVEA=0
  776.             ELSE
  777. C No left parenthesis found; incorrect assertion format.
  778.                 CALL ERRORS(21)
  779.                 ISAVEA=1
  780.             END IF
  781.         END IF
  782.  100    IF (ISAVEA.EQ.1) THEN
  783. C Count comments (do not include assertions)
  784.             CALL COUNTS(LCMNTG)
  785.             IF (NCOMG.LT.MAXCMG) THEN
  786. C Save this comment for output prior to statement.
  787.                 NCOMG=NCOMG+1
  788.                 ICOMG(NCOMG)=CARD
  789.             END IF
  790.         END IF
  791.  
  792.         END
  793. C ----------------------------------------------------------------------
  794. C
  795. C       C O U N T S   -   Update all program, routine and segment static
  796. C                         counts for this item.
  797. C
  798.  
  799.         SUBROUTINE COUNTS(ITEM)
  800.         INTEGER ITEM
  801.  
  802. C---------------------------------------------------------
  803. C    TOOLPACK/1    Release: 2.3
  804. C---------------------------------------------------------
  805. C                  MAIN INTEGER STORAGE ARRAYS
  806. C MAXLBG = Maximum number of DO statement labels per routine
  807.         INTEGER MAXLBG
  808.         PARAMETER(MAXLBG=100)
  809.         COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
  810.      *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
  811.      *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
  812.         INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
  813.      +          KEXECG,LABG,KTOKG
  814.         SAVE /WORKC/
  815.  
  816. C Increment Program, Routine and Segment counts
  817.         IPCNTG(ITEM)=IPCNTG(ITEM)+1
  818.         IRCNTG(ITEM)=IRCNTG(ITEM)+1
  819.         ISCNTG(ITEM)=ISCNTG(ITEM)+1
  820.  
  821.         END
  822. C ----------------------------------------------------------------------
  823. C
  824. C       D A R G S   -  Pick up dummy arguments from subroutine, function
  825. C                      and entry argument lists
  826. C
  827.  
  828.         SUBROUTINE DARGS
  829.  
  830. C---------------------------------------------------------
  831. C    TOOLPACK/1    Release: 2.3
  832. C---------------------------------------------------------
  833. C Character variables and arrays, except for dictionaries & VNAMEG
  834.         INTEGER MAXCMG
  835.         PARAMETER(MAXCMG=30)
  836.         COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
  837.  
  838.         CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
  839.         CHARACTER*6 NAMEG
  840.         CHARACTER*72 ICOMG(MAXCMG)
  841.  
  842.         SAVE /CHARC/
  843. C---------------------------------------------------------
  844. C    TOOLPACK/1    Release: 2.3
  845. C---------------------------------------------------------
  846. C                  CONTROL VARIABLES
  847.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  848.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  849.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  850.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  851.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  852.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  853.      *         NSTMG,       NTREEG,      NTYPEG
  854.  
  855.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  856.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  857.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  858.      +          NTREEG,NTYPEG
  859.  
  860.         SAVE /CNTRLC/
  861.  
  862. C---------------------------------------------------------
  863. C    TOOLPACK/1    Release: 2.3
  864. C---------------------------------------------------------
  865. C Dictionary
  866. C   MAXDDG = Maximum number of dimension names in dictionary
  867. C   MAXRDG = Maximum number of routine names in dictionary
  868.         INTEGER MAXDDG,MAXRDG
  869.         PARAMETER(MAXDDG=150,MAXRDG=250)
  870.         COMMON /ANDICT/ DDICTG,RDICTG
  871.         CHARACTER*6 DDICTG(MAXDDG),RDICTG(MAXRDG)
  872.         SAVE /ANDICT/
  873. C---------------------------------------------------------
  874. C    TOOLPACK/1    Release: 2.3
  875. C---------------------------------------------------------
  876. C                  KEYWORD ID VARIABLES
  877.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  878.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  879.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  880.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  881.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  882.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  883.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  884.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  885.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  886.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  887.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  888.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  889.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  890.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  891.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  892.      *         LLINEG,      LSTMTG
  893.  
  894.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  895.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  896.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  897.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  898.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  899.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  900.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  901.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  902.         INTEGER KUFUNG,KSUBRG
  903.  
  904.         SAVE /KEYSC/
  905.  
  906. C---------------------------------------------------------
  907. C    TOOLPACK/1    Release: 2.3
  908. C---------------------------------------------------------
  909.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  910.      +                MAXICH
  911.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  912.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  913.      +          MAXICH
  914.  
  915.         SAVE /TOKENS/
  916.  
  917. C
  918. C TOKTYP = array of token types for current statement
  919. C TOKLEN = parallel array of lengths of associated text strings
  920. C TXTPTR = parallel array of pointers into ISTMG character array of text
  921. C TOKEN = Current token number within statement being processed
  922. C NTOKSS = Number of tokens in statement
  923. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  924. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  925. C MAXICH = Last character used in ISTTXT array
  926. C
  927. C---------------------------------------------------------
  928. C    TOOLPACK/1    Release: 2.4
  929. C---------------------------------------------------------
  930. C
  931. C  TKLAST = LAST TOKEN NUMBER
  932. C
  933.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  934.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  935.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  936.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  937.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  938.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  939.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  940.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  941.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  942.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  943.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  944.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  945.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  946.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  947.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  948.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  949.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  950.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  951.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  952.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  953.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  954.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  955.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  956.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  957.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  958.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  959.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  960.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  961.  
  962.  
  963.         INTEGER ITOK,JTOK,KTOK,LOCL
  964.         CHARACTER*6 NAMEL
  965.  
  966.         CHARACTER*6 NAME
  967.         INTEGER SFINDT
  968.  
  969. C Find start of argument list
  970. *$AS$ (ITYPEG.EQ.KSUBRG .OR. ITYPEG.EQ.KNTRYG .OR. ITYPEG.EQ.KCFUNG .OR.
  971. *$AS$  ITYPEG.EQ.KXFUNG .OR. ITYPEG.EQ.KDFUNG .OR. ITYPEG.EQ.KIFUNG .OR.
  972. *$AS$  ITYPEG.EQ.KLFUNG .OR. ITYPEG.EQ.KRFUNG .OR. ITYPEG.EQ.KUFUNG)
  973.         ITOK=NTOKG
  974.  100    ITOK=ITOK+1
  975.         IF (ITOK.LT.NTOKSS .AND. TOKTYP(ITOK).NE.TLPARN) GOTO 100
  976.         IF (TOKTYP(ITOK).EQ.TLPARN) THEN
  977. C Routine has an argument list
  978.             CALL BALPRT(ITOK,KTOK)
  979. C Is it all there?
  980.             IF (KTOK.NE.0) THEN
  981. C Look for comma
  982.  200            JTOK=SFINDT(ITOK)
  983.                 IF (TOKTYP(JTOK).NE.TCOMMA) JTOK=KTOK
  984.                 NAMEL=' '
  985.                 IF (TOKTYP(JTOK+1).EQ.TNAME) NAMEL=NAME(JTOK+1)
  986.                 IF (NAMEL.NE.' ') THEN
  987. C Save argument mnemonic as possible dummy routine name
  988.                     CALL NSAVES(NAMEL,DDICTG,NDDICG,MAXDDG,LOCL)
  989. C Write message if dictionary overflowed
  990.                     IF (LOCL.EQ.0) CALL ERRORS(13)
  991.                 END IF
  992.                 IF (JTOK.LT.KTOK) THEN
  993.                     ITOK=JTOK
  994.                     GOTO 200
  995.                 END IF
  996.             ELSE
  997. C Parenthetical group not balanced
  998.                 CALL ERRORS(12)
  999.             END IF
  1000.         END IF
  1001.  
  1002.         END
  1003. C ----------------------------------------------------------------------
  1004. C
  1005. C       D M P C M S   -   Dump comment buffer to listing
  1006. C
  1007.  
  1008.         SUBROUTINE DMPCMS
  1009.  
  1010. C---------------------------------------------------------
  1011. C    TOOLPACK/1    Release: 2.3
  1012. C---------------------------------------------------------
  1013. C Character variables and arrays, except for dictionaries & VNAMEG
  1014.         INTEGER MAXCMG
  1015.         PARAMETER(MAXCMG=30)
  1016.         COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
  1017.  
  1018.         CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
  1019.         CHARACTER*6 NAMEG
  1020.         CHARACTER*72 ICOMG(MAXCMG)
  1021.  
  1022.         SAVE /CHARC/
  1023. C---------------------------------------------------------
  1024. C    TOOLPACK/1    Release: 2.3
  1025. C---------------------------------------------------------
  1026. C                  CONTROL VARIABLES
  1027.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  1028.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  1029.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  1030.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  1031.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  1032.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  1033.      *         NSTMG,       NTREEG,      NTYPEG
  1034.  
  1035.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  1036.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  1037.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  1038.      +          NTREEG,NTYPEG
  1039.  
  1040.         SAVE /CNTRLC/
  1041.  
  1042. C---------------------------------------------------------
  1043. C    TOOLPACK/1    Release: 2.3
  1044. C---------------------------------------------------------
  1045.         COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  1046.         INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  1047.  
  1048.         SAVE /IO/
  1049.  
  1050. C---------------------------------------------------------
  1051. C    TOOLPACK/1    Release: 2.4
  1052. C---------------------------------------------------------
  1053. C
  1054. C  TKLAST = LAST TOKEN NUMBER
  1055. C
  1056.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1057.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1058.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1059.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1060.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1061.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1062.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1063.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1064.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1065.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1066.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1067.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1068.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1069.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1070.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1071.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1072.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1073.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1074.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1075.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1076.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1077.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1078.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1079.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1080.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1081.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1082.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1083.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1084.  
  1085.  
  1086.         INTEGER L
  1087.  
  1088.         IF (NCOMG.GT.0) THEN
  1089.             DO 100 L=1,NCOMG
  1090.                 CALL WRITOK(TCMMNT,ICOMG(L))
  1091.   100       CONTINUE
  1092.             NCOMG=0
  1093.         END IF
  1094.  
  1095.         END
  1096. C ----------------------------------------------------------------------
  1097. C
  1098. C       E R R O R S   -   Output an error message
  1099. C
  1100.  
  1101.         SUBROUTINE ERRORS(NERRA)
  1102.         INTEGER NERRA
  1103.  
  1104. C---------------------------------------------------------
  1105. C    TOOLPACK/1    Release: 2.3
  1106. C---------------------------------------------------------
  1107. C Character variables and arrays, except for dictionaries & VNAMEG
  1108.         INTEGER MAXCMG
  1109.         PARAMETER(MAXCMG=30)
  1110.         COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
  1111.  
  1112.         CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
  1113.         CHARACTER*6 NAMEG
  1114.         CHARACTER*72 ICOMG(MAXCMG)
  1115.  
  1116.         SAVE /CHARC/
  1117. C---------------------------------------------------------
  1118. C    TOOLPACK/1    Release: 2.3
  1119. C---------------------------------------------------------
  1120. C                  CONTROL VARIABLES
  1121.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  1122.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  1123.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  1124.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  1125.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  1126.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  1127.      *         NSTMG,       NTREEG,      NTYPEG
  1128.  
  1129.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  1130.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  1131.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  1132.      +          NTREEG,NTYPEG
  1133.  
  1134.         SAVE /CNTRLC/
  1135.  
  1136. C---------------------------------------------------------
  1137. C    TOOLPACK/1    Release: 2.3
  1138. C---------------------------------------------------------
  1139. C Dictionary
  1140. C   MAXDDG = Maximum number of dimension names in dictionary
  1141. C   MAXRDG = Maximum number of routine names in dictionary
  1142.         INTEGER MAXDDG,MAXRDG
  1143.         PARAMETER(MAXDDG=150,MAXRDG=250)
  1144.         COMMON /ANDICT/ DDICTG,RDICTG
  1145.         CHARACTER*6 DDICTG(MAXDDG),RDICTG(MAXRDG)
  1146.         SAVE /ANDICT/
  1147. C---------------------------------------------------------
  1148. C    TOOLPACK/1    Release: 2.3
  1149. C---------------------------------------------------------
  1150. C                  KEYWORD ID VARIABLES
  1151.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  1152.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  1153.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  1154.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  1155.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  1156.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  1157.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  1158.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  1159.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  1160.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  1161.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  1162.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  1163.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  1164.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  1165.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  1166.      *         LLINEG,      LSTMTG
  1167.  
  1168.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  1169.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  1170.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  1171.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  1172.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  1173.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  1174.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  1175.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  1176.         INTEGER KUFUNG,KSUBRG
  1177.  
  1178.         SAVE /KEYSC/
  1179.  
  1180. C---------------------------------------------------------
  1181. C    TOOLPACK/1    Release: 2.3
  1182. C---------------------------------------------------------
  1183. C                  LOGICAL VARIABLES
  1184.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  1185.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  1186.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  1187.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  1188.      *         TREEG
  1189.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  1190.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  1191.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  1192.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  1193.  
  1194.         SAVE /LOGIC/
  1195.  
  1196. C---------------------------------------------------------
  1197. C    TOOLPACK/1    Release: 2.3
  1198. C---------------------------------------------------------
  1199.         COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  1200.         INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  1201.  
  1202.         SAVE /IO/
  1203.  
  1204. C---------------------------------------------------------
  1205. C    TOOLPACK/1    Release: 2.4
  1206. C---------------------------------------------------------
  1207. C
  1208. C  TKLAST = LAST TOKEN NUMBER
  1209. C
  1210.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1211.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1212.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1213.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1214.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1215.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1216.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1217.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1218.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1219.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1220.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1221.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1222.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1223.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1224.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1225.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1226.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1227.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1228.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1229.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1230.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1231.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1232.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1233.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1234.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1235.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1236.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1237.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1238.  
  1239. C---------------------------------------------------------
  1240. C    TOOLPACK/1    Release: 2.3
  1241. C---------------------------------------------------------
  1242. C                  MAIN INTEGER STORAGE ARRAYS
  1243. C MAXLBG = Maximum number of DO statement labels per routine
  1244.         INTEGER MAXLBG
  1245.         PARAMETER(MAXLBG=100)
  1246.         COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
  1247.      *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
  1248.      *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
  1249.         INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
  1250.      +          KEXECG,LABG,KTOKG
  1251.         SAVE /WORKC/
  1252.  
  1253.         EXTERNAL ERROR,REMARK,ZCHOUT,ZPTINT,ZMESS
  1254.  
  1255.         GOTO (100,110,120,130,150,160,170,180,190,200,210,220,230,240,
  1256.      +        250,260,270,280,290,300,310) NERRA
  1257.         CALL ERROR('Invalid argument to ERRORS')
  1258.  
  1259.  100    CALL ERROR('BAD ERRORS CALL 1')
  1260.  
  1261.  110    CALL ERROR('BAD ERRORS CALL 2')
  1262.  
  1263.  120    CALL ERROR('BAD ERRORS CALL 3')
  1264.  
  1265.  130    CALL ERROR('Input source file is -1')
  1266.  
  1267.  150    CONTINUE
  1268.         CALL REMARK('Error: End of assertion statement missing')
  1269.         CALL WRITOK(TCMMNT,'C*AN*ERROR* End of assertion missing')
  1270.         CALL COUNTS(LERRG)
  1271.         GOTO 666
  1272.  
  1273.  160    CONTINUE
  1274.         CALL REMARK('Error: Assertion too long')
  1275.         CALL WRITOK(TCMMNT,'C*AN*ERROR* Assertion too long')
  1276.         CALL COUNTS(LERRG)
  1277.         GOTO 666
  1278.  
  1279.  170    CONTINUE
  1280.         CALL REMARK('Error: Unrecognisable statement')
  1281.         CALL WRITOK(TCMMNT,'C*AN*ERROR* Unrecognisable statement')
  1282.         CALL COUNTS(LERRG)
  1283.         GOTO 666
  1284.  
  1285.  180    CALL ERROR('BAD ERROR CALL 8')
  1286.  
  1287.  190    CONTINUE
  1288.         CALL REMARK('Error: No STOP statements found')
  1289.         CALL REMARK('       Insert wrapup calls at termination points')
  1290.         GOTO 666
  1291.  
  1292.  200    CALL ERROR('BAD ERROR CALL 10')
  1293.  
  1294.  210    CALL ERROR('BAD ERROR CALL 11')
  1295.  
  1296.  220    CONTINUE
  1297.         CALL REMARK('Error: Unbalanced parentheses')
  1298.         CALL WRITOK(TCMMNT,'C*AN*ERROR* Unbalanced parentheses')
  1299.         CALL COUNTS(LERRG)
  1300.         GOTO 666
  1301.  
  1302.  230    IF (IERRG.EQ.0) THEN
  1303.             CALL ZCHOUT('Error: More than ',2)
  1304.             CALL ZPTINT(MAXDDG,1,2)
  1305.             CALL ZMESS(' in routine '//NAMEG,2)
  1306.             IERRG = 1
  1307.         END IF
  1308.         GOTO 666
  1309.  
  1310.  240    CALL ZCHOUT('Error: More than ',2)
  1311.         CALL ZPTINT(MAXRDG,1,2)
  1312.         CALL ZMESS(' routines an'//'d routine references',2)
  1313.         CALL ERROR('  ISTAN stopped at routine '//NAMEG)
  1314.  
  1315.  250    CALL ERROR('BAD ERRORS CALL 15')
  1316.  
  1317.  260    CALL ERROR('BAD ERRORS CALL 16')
  1318.  
  1319.  270    IF (JERRG.EQ.0) THEN
  1320.             CALL ZCHOUT('Error: DO-loops nested to more than ',2)
  1321.             CALL ZPTINT(MAXLBG,1,2)
  1322.             CALL ZMESS(' levels in routine '//NAMEG,2)
  1323.             CALL REMARK(
  1324.      +'       Loop-end statements will be segments at deeper levels')
  1325.             JERRG = 1
  1326.         END IF
  1327.         GOTO 666
  1328.  
  1329.  280    CALL ERROR('BAD ERRORS CALL 18')
  1330.  
  1331.  290    CALL ERROR('BAD ERRORS CALL 19')
  1332.  
  1333.  300    CALL REMARK('Error: Last statement in program isn''t END')
  1334.         GOTO 666
  1335.  
  1336.  310    CALL REMARK('Error: Invalid Assertion')
  1337.         CALL WRITOK(TCMMNT,'C*AN*ERROR* Invalid Assertion')
  1338.         CALL COUNTS(LERRG)
  1339.         GOTO 666
  1340.  
  1341.  666    RETURN
  1342.  
  1343.         END
  1344. C ----------------------------------------------------------------------
  1345. C
  1346. C       E X E C S   -   Output first routine segment when executable code
  1347. C                       reached
  1348. C
  1349.  
  1350.         SUBROUTINE EXECS
  1351.  
  1352. C---------------------------------------------------------
  1353. C    TOOLPACK/1    Release: 2.3
  1354. C---------------------------------------------------------
  1355. C Character variables and arrays, except for dictionaries & VNAMEG
  1356.         INTEGER MAXCMG
  1357.         PARAMETER(MAXCMG=30)
  1358.         COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
  1359.  
  1360.         CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
  1361.         CHARACTER*6 NAMEG
  1362.         CHARACTER*72 ICOMG(MAXCMG)
  1363.  
  1364.         SAVE /CHARC/
  1365. C---------------------------------------------------------
  1366. C    TOOLPACK/1    Release: 2.3
  1367. C---------------------------------------------------------
  1368. C                  LOGICAL VARIABLES
  1369.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  1370.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  1371.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  1372.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  1373.      *         TREEG
  1374.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  1375.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  1376.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  1377.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  1378.  
  1379.         SAVE /LOGIC/
  1380.  
  1381. C---------------------------------------------------------
  1382. C    TOOLPACK/1    Release: 2.3
  1383. C---------------------------------------------------------
  1384. C                  CONTROL VARIABLES
  1385.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  1386.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  1387.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  1388.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  1389.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  1390.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  1391.      *         NSTMG,       NTREEG,      NTYPEG
  1392.  
  1393.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  1394.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  1395.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  1396.      +          NTREEG,NTYPEG
  1397.  
  1398.         SAVE /CNTRLC/
  1399.  
  1400. C---------------------------------------------------------
  1401. C    TOOLPACK/1    Release: 2.3
  1402. C---------------------------------------------------------
  1403. C                  KEYWORD ID VARIABLES
  1404.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  1405.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  1406.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  1407.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  1408.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  1409.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  1410.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  1411.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  1412.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  1413.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  1414.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  1415.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  1416.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  1417.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  1418.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  1419.      *         LLINEG,      LSTMTG
  1420.  
  1421.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  1422.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  1423.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  1424.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  1425.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  1426.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  1427.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  1428.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  1429.         INTEGER KUFUNG,KSUBRG
  1430.  
  1431.         SAVE /KEYSC/
  1432.  
  1433. C---------------------------------------------------------
  1434. C    TOOLPACK/1    Release: 2.3
  1435. C---------------------------------------------------------
  1436. C                  MAIN INTEGER STORAGE ARRAYS
  1437. C MAXLBG = Maximum number of DO statement labels per routine
  1438.         INTEGER MAXLBG
  1439.         PARAMETER(MAXLBG=100)
  1440.         COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
  1441.      *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
  1442.      *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
  1443.         INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
  1444.      +          KEXECG,LABG,KTOKG
  1445.         SAVE /WORKC/
  1446. C---------------------------------------------------------
  1447. C    TOOLPACK/1    Release: 2.4
  1448. C---------------------------------------------------------
  1449. C
  1450. C  TKLAST = LAST TOKEN NUMBER
  1451. C
  1452.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1453.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1454.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1455.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1456.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1457.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1458.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1459.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1460.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1461.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1462.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1463.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1464.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1465.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1466.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1467.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1468.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1469.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1470.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1471.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1472.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1473.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1474.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1475.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1476.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1477.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1478.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1479.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1480.  
  1481. C---------------------------------------------------------
  1482. C    TOOLPACK/1    Release: 2.3
  1483. C---------------------------------------------------------
  1484.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  1485.      +                MAXICH
  1486.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  1487.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  1488.      +          MAXICH
  1489.  
  1490.         SAVE /TOKENS/
  1491.  
  1492. C
  1493. C TOKTYP = array of token types for current statement
  1494. C TOKLEN = parallel array of lengths of associated text strings
  1495. C TXTPTR = parallel array of pointers into ISTMG character array of text
  1496. C TOKEN = Current token number within statement being processed
  1497. C NTOKSS = Number of tokens in statement
  1498. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  1499. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  1500. C MAXICH = Last character used in ISTTXT array
  1501. C
  1502. C---------------------------------------------------------
  1503. C    TOOLPACK/1    Release: 2.3
  1504. C---------------------------------------------------------
  1505.         COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  1506.         INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  1507.  
  1508.         SAVE /IO/
  1509.  
  1510.  
  1511.         INTEGER DUMMY(2),LABEL(7),I
  1512.         CHARACTER*6 SEGNUM
  1513.  
  1514.         INTEGER LENGTH
  1515.         EXTERNAL ZTOKWR,SCOPY,LENGTH
  1516.  
  1517.         DATA DUMMY(1)/129/
  1518.  
  1519.         EXECG = .TRUE.
  1520. C Output first routine segment, unlabelled.
  1521.         IF (TOKTYP(1).EQ.TDCNST) THEN
  1522.             CALL SCOPY(ISTTXT,ISTPTR(1),LABEL,1)
  1523.             DO 100 I=1,LENGTH(LABEL)
  1524.                 ISTTXT(ISTPTR(1)+I-1)=32
  1525.  100        CONTINUE
  1526.         END IF
  1527.         IF (LTYPEG.EQ.KENDG) THEN
  1528.             IF (TOKTYP(1).EQ.TDCNST) THEN
  1529. C This is first line of main routine and is labelled.
  1530. C Output extra annotation line for first segment.
  1531.                 WRITE (SEGNUM,9000) NMSEG
  1532.                 CALL WRITOK(TCMMNT,'*$AN$'//SEGNUM)
  1533.                 CALL ZTOKWR(TPROGR,0,DUMMY,TKODES)
  1534.                 CALL WRITOK(TNAME,'MAIN')
  1535.                 CALL ZTOKWR(TZEOS,0,DUMMY,TKODES)
  1536.                 CALL OUTSGS(ISBEG(NRTNG))
  1537.                 SEGMTG=.FALSE.
  1538.             ELSE
  1539. C This is first line of main routine and not labelled - perform
  1540. C no special processing.
  1541.             END IF
  1542.         ELSE
  1543. C This is first executable line of routine but not first statement
  1544. C of routine. Output first segment with no other special processing.
  1545.             CALL OUTSGS(ISBEG(NRTNG))
  1546.             SEGMTG=.FALSE.
  1547.         END IF
  1548.  
  1549.         IF (TOKTYP(1).EQ.TDCNST) CALL SCOPY(LABEL,1,ISTTXT,ISTPTR(1))
  1550.  
  1551. 9000    FORMAT(SS,I5)
  1552.         END
  1553.